home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / x11 / x-init.el.z / x-init.el
Encoding:
Text File  |  1998-05-21  |  12.9 KB  |  325 lines
  1. ;;; x-init.el --- initialization code for X windows
  2. ;; Copyright (C) 1990, 1993, 1994 Free Software Foundation, Inc.
  3. ;; Copyright (C) 1995 Board of Trustees, University of Illinois.
  4. ;; Copyright (C) 1995, 1996 Ben Wing.
  5.  
  6. ;; Author: various
  7. ;; Keywords: terminals
  8.  
  9. ;; This file is part of XEmacs.
  10.  
  11. ;; XEmacs is free software; you can redistribute it and/or modify it
  12. ;; under the terms of the GNU General Public License as published by
  13. ;; the Free Software Foundation; either version 2, or (at your option)
  14. ;; any later version.
  15.  
  16. ;; XEmacs is distributed in the hope that it will be useful, but
  17. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  18. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  19. ;; General Public License for more details.
  20.  
  21. ;; You should have received a copy of the GNU General Public License
  22. ;; along with XEmacs; see the file COPYING.  If not, write to the
  23. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  24. ;; Boston, MA 02111-1307, USA.
  25.  
  26. ;;; Commentary:
  27.  
  28. ;;; Code:
  29.  
  30. ;;; If you want to change this variable, this is the place you must do it.
  31. ;;; Do not set it to a string containing periods.  X doesn't like that.
  32. ;(setq x-emacs-application-class "Emacs")
  33.  
  34. ;;; selections and active regions
  35.  
  36. ;;; If and only if zmacs-regions is true:
  37. ;;;
  38. ;;; When a mark is pushed and the region goes into the "active" state, we
  39. ;;; assert it as the Primary selection.  This causes it to be hilighted.
  40. ;;; When the region goes into the "inactive" state, we disown the Primary
  41. ;;; selection, causing the region to be dehilighted.
  42. ;;;
  43. ;;; Note that it is possible for the region to be in the "active" state
  44. ;;; and not be hilighted, if it is in the active state and then some other
  45. ;;; application asserts the selection.  This is probably not a big deal.
  46.  
  47. (defun x-activate-region-as-selection ()
  48.   (if (marker-buffer (mark-marker t))
  49.       (x-own-selection (cons (point-marker t) (mark-marker t)))))
  50.  
  51. ;;; OpenWindows-like "find" processing.  These functions are really Sunisms,
  52. ;;; but we put them here instead of in x-win-sun.el in case someone wants
  53. ;;; to use them when not running on a Sun console (presumably after binding
  54. ;;; them to different keys, or putting them on menus.)
  55.  
  56. (defvar ow-find-last-string nil)
  57. (defvar ow-find-last-clipboard nil)
  58.  
  59. (defun ow-find (&optional backward-p)
  60.   "Search forward the next occurrence of the text of the selection."
  61.   (interactive)
  62.   (let ((sel (condition-case () (x-get-selection) (error nil)))
  63.     (clip (condition-case () (x-get-clipboard) (error nil)))
  64.     text)
  65.     (setq text (cond
  66.         (sel)
  67.         ((not (equal clip ow-find-last-clipboard))
  68.          (setq ow-find-last-clipboard clip))
  69.         (ow-find-last-string)
  70.         (t (error "No selection available"))))
  71.     (setq ow-find-last-string text)
  72.     (cond (backward-p
  73.        (search-backward text)
  74.        (set-mark (+ (point) (length text))))
  75.       (t
  76.        (search-forward text)
  77.        (set-mark (- (point) (length text)))))
  78.     (zmacs-activate-region)))
  79.  
  80. (defun ow-find-backward ()
  81.   "Search backward for the previous occurrence of the text of the selection."
  82.   (interactive)
  83.   (ow-find t))
  84.  
  85. ;;; Load X-server specific code.
  86. ;;; Specifically, load some code to repair the grievous damage that MIT and
  87. ;;; Sun have done to the default keymap for the Sun keyboards.
  88.  
  89. (eval-when-compile
  90.   (defmacro x-define-dead-key (key map)
  91.     `(when (x-keysym-on-keyboard-p ',key)
  92.        (define-key function-key-map [,key] ',map))))
  93.  
  94. (defun x-initialize-compose ()
  95.   "Enable compose processing"
  96.   (autoload 'compose-map        "x-compose" nil t 'keymap)
  97.   (autoload 'compose-acute-map        "x-compose" nil t 'keymap)
  98.   (autoload 'compose-grave-map        "x-compose" nil t 'keymap)
  99.   (autoload 'compose-cedilla-map    "x-compose" nil t 'keymap)
  100.   (autoload 'compose-diaeresis-map  "x-compose" nil t 'keymap)
  101.   (autoload 'compose-circumflex-map "x-compose" nil t 'keymap)
  102.   (autoload 'compose-tilde-map        "x-compose" nil t 'keymap)
  103.  
  104.   (when (x-keysym-on-keyboard-p 'multi-key)
  105.     (define-key function-key-map [multi-key] 'compose-map))
  106.  
  107.   ;; The dead keys might really be called just about anything, depending
  108.   ;; on the vendor.  MIT thinks that the prefixes are "SunFA_", "D", and
  109.   ;; "hpmute_" for Sun, DEC, and HP respectively.  However, OpenWindows 3
  110.   ;; thinks that the prefixes are "SunXK_FA_", "DXK_", and "hpXK_mute_".
  111.   ;; And HP (who don't mention Sun and DEC at all) use "XK_mute_".
  112.   ;; Go figure.
  113.  
  114.   ;; Presumably if someone is running OpenWindows, they won't be using
  115.   ;; the DEC or HP keysyms, but if they are defined then that is possible,
  116.   ;; so in that case we accept them all.
  117.  
  118.   ;; If things seem not to be working, you might want to check your
  119.   ;; /usr/lib/X11/XKeysymDB file to see if your vendor has an equally
  120.   ;; mixed up view of what these keys should be called.
  121.  
  122.   ;; Canonical names:
  123.   (x-define-dead-key acute            compose-acute-map)
  124.   (x-define-dead-key grave            compose-grave-map)
  125.   (x-define-dead-key cedilla            compose-cedilla-map)
  126.   (x-define-dead-key diaeresis            compose-diaeresis-map)
  127.   (x-define-dead-key circumflex            compose-circumflex-map)
  128.   (x-define-dead-key tilde            compose-tilde-map)
  129.   (x-define-dead-key degree            compose-ring-map)
  130.  
  131.   ;; Sun according to MIT:
  132.   (x-define-dead-key SunFA_Acute        compose-acute-map)
  133.   (x-define-dead-key SunFA_Grave        compose-grave-map)
  134.   (x-define-dead-key SunFA_Cedilla        compose-cedilla-map)
  135.   (x-define-dead-key SunFA_Diaeresis        compose-diaeresis-map)
  136.   (x-define-dead-key SunFA_Circum        compose-circumflex-map)
  137.   (x-define-dead-key SunFA_Tilde        compose-tilde-map)
  138.  
  139.   ;; Sun according to OpenWindows 2:
  140.   (x-define-dead-key Dead_Grave            compose-grave-map)
  141.   (x-define-dead-key Dead_Circum        compose-circumflex-map)
  142.   (x-define-dead-key Dead_Tilde            compose-tilde-map)
  143.  
  144.   ;; Sun according to OpenWindows 3:
  145.   (x-define-dead-key SunXK_FA_Acute        compose-acute-map)
  146.   (x-define-dead-key SunXK_FA_Grave        compose-grave-map)
  147.   (x-define-dead-key SunXK_FA_Cedilla        compose-cedilla-map)
  148.   (x-define-dead-key SunXK_FA_Diaeresis        compose-diaeresis-map)
  149.   (x-define-dead-key SunXK_FA_Circum        compose-circumflex-map)
  150.   (x-define-dead-key SunXK_FA_Tilde        compose-tilde-map)
  151.  
  152.   ;; DEC according to MIT:
  153.   (x-define-dead-key Dacute_accent        compose-acute-map)
  154.   (x-define-dead-key Dgrave_accent        compose-grave-map)
  155.   (x-define-dead-key Dcedilla_accent        compose-cedilla-map)
  156.   (x-define-dead-key Dcircumflex_accent        compose-circumflex-map)
  157.   (x-define-dead-key Dtilde            compose-tilde-map)
  158.   (x-define-dead-key Dring_accent        compose-ring-map)
  159.  
  160.   ;; DEC according to OpenWindows 3:
  161.   (x-define-dead-key DXK_acute_accent        compose-acute-map)
  162.   (x-define-dead-key DXK_grave_accent        compose-grave-map)
  163.   (x-define-dead-key DXK_cedilla_accent        compose-cedilla-map)
  164.   (x-define-dead-key DXK_circumflex_accent    compose-circumflex-map)
  165.   (x-define-dead-key DXK_tilde            compose-tilde-map)
  166.   (x-define-dead-key DXK_ring_accent        compose-ring-map)
  167.  
  168.   ;; HP according to MIT:
  169.   (x-define-dead-key hpmute_acute        compose-acute-map)
  170.   (x-define-dead-key hpmute_grave        compose-grave-map)
  171.   (x-define-dead-key hpmute_diaeresis        compose-diaeresis-map)
  172.   (x-define-dead-key hpmute_asciicircum        compose-circumflex-map)
  173.   (x-define-dead-key hpmute_asciitilde        compose-tilde-map)
  174.  
  175.   ;; Empirically discovered on Linux XFree86 MetroX:
  176.   (x-define-dead-key usldead_acute        compose-acute-map)
  177.   (x-define-dead-key usldead_grave        compose-grave-map)
  178.   (x-define-dead-key usldead_diaeresis        compose-diaeresis-map)
  179.   (x-define-dead-key usldead_asciicircum    compose-circumflex-map)
  180.   (x-define-dead-key usldead_asciitilde        compose-tilde-map)
  181.  
  182.   ;; HP according to OpenWindows 3:
  183.   (x-define-dead-key hpXK_mute_acute        compose-acute-map)
  184.   (x-define-dead-key hpXK_mute_grave        compose-grave-map)
  185.   (x-define-dead-key hpXK_mute_diaeresis    compose-diaeresis-map)
  186.   (x-define-dead-key hpXK_mute_asciicircum    compose-circumflex-map)
  187.   (x-define-dead-key hpXK_mute_asciitilde    compose-tilde-map)
  188.  
  189.   ;; HP according to HP-UX 8.0:
  190.   (x-define-dead-key XK_mute_acute        compose-acute-map)
  191.   (x-define-dead-key XK_mute_grave        compose-grave-map)
  192.   (x-define-dead-key XK_mute_diaeresis        compose-diaeresis-map)
  193.   (x-define-dead-key XK_mute_asciicircum    compose-circumflex-map)
  194.   (x-define-dead-key XK_mute_asciitilde        compose-tilde-map)
  195.  
  196.   ;; Xfree86 seems to use lower case and a hyphen
  197.   (x-define-dead-key dead-acute            compose-acute-map)
  198.   (x-define-dead-key dead-grave            compose-grave-map)
  199.   (x-define-dead-key dead-cedilla        compose-cedilla-map)
  200.   (x-define-dead-key dead-diaeresis        compose-diaeresis-map)
  201.   (x-define-dead-key dead-circum        compose-circumflex-map)
  202.   (x-define-dead-key dead-tilde            compose-tilde-map)
  203.   )
  204.  
  205. (defun x-initialize-keyboard ()
  206.   "Perform X-Server-specific initializations.  Don't call this."
  207.   ;; This is some heuristic junk that tries to guess whether this is
  208.   ;; a Sun keyboard.
  209.   ;;
  210.   ;; One way of implementing this (which would require C support) would
  211.   ;; be to examine the X keymap itself and see if the layout looks even
  212.   ;; remotely like a Sun - check for the Find key on a particular
  213.   ;; keycode, for example.  It'd be nice to have a table of this to
  214.   ;; recognize various keyboards; see also xkeycaps.
  215.   (let ((vendor (x-server-vendor)))
  216.     (cond ((or (string-match "Sun Microsystems" vendor)
  217.            ;; MIT losingly fails to tell us what hardware the X server
  218.            ;; is managing, so assume all MIT displays are Suns...  HA HA!
  219.            (string-equal "MIT X Consortium" vendor)
  220.            (string-equal "X Consortium" vendor))
  221.            ;; Ok, we think this could be a Sun keyboard.  Load the Sun code.
  222.            (load "x-win-sun"))
  223.           ((string-match "XFree86" vendor)
  224.            ;; Those XFree86 people do some weird keysym stuff, too.
  225.            (load "x-win-xfree86")))))
  226.  
  227.  
  228. (defvar pre-x-win-initted nil)
  229.  
  230. (defun init-pre-x-win ()
  231.   "Initialize X Windows at startup (pre).  Don't call this."
  232.   (when (not pre-x-win-initted)
  233.     (require 'x-iso8859-1)
  234.     (setq character-set-property 'x-iso8859/1) ; see x-iso8859-1.el
  235.  
  236.     (setq initial-frame-plist (if initial-frame-unmapped-p
  237.                                   '(initially-unmapped t)
  238.                                 nil))
  239.     (setq pre-x-win-initted t)))
  240.  
  241. (defvar x-win-initted nil)
  242.  
  243. (defun init-x-win ()
  244.   "Initialize X Windows at startup.  Don't call this."
  245.   (when (not x-win-initted)
  246.     (init-pre-x-win)
  247.  
  248.     ;; Open the X display when this file is loaded
  249.     ;; (Note that the first frame is created later.)
  250.     (setq x-initial-argv-list (cons (car command-line-args)
  251.                                     command-line-args-left))
  252.     (make-x-device nil)
  253.     (setq command-line-args-left (cdr x-initial-argv-list))
  254.     (setq x-win-initted t)))
  255.  
  256. (defvar post-x-win-initted nil)
  257.  
  258. (defun init-post-x-win ()
  259.   "Initialize X Windows at startup (post).  Don't call this."
  260.   (when (not post-x-win-initted)
  261.     ;; We can't load this until after the initial X device is created
  262.     ;; because the icon initialization needs to access the display to get
  263.     ;; any toolbar-related color resources.
  264.     (if (featurep 'toolbar)
  265.         (init-x-toolbar))
  266.     (if (featurep 'mule)
  267.         (init-mule-x-win))
  268.     ;; these are only ever called if zmacs-regions is true.
  269.     (add-hook 'zmacs-deactivate-region-hook
  270.           (lambda ()
  271.         (if (console-on-window-system-p)
  272.             (x-disown-selection))))
  273.     (add-hook 'zmacs-activate-region-hook
  274.           (lambda ()
  275.         (if (console-on-window-system-p)
  276.             (x-activate-region-as-selection))))
  277.     (add-hook 'zmacs-update-region-hook
  278.           (lambda ()
  279.         (if (console-on-window-system-p)
  280.             (x-activate-region-as-selection))))
  281.     ;; Motif-ish bindings
  282.     ;; The following two were generally unliked.
  283.     ;;(define-key global-map '(shift delete)   'x-kill-primary-selection)
  284.     ;;(define-key global-map '(control delete) 'x-delete-primary-selection)
  285.     (define-key global-map '(shift insert)   'x-yank-clipboard-selection)
  286.     (define-key global-map '(control insert) 'x-copy-primary-selection)
  287.     ;; These are Sun-isms.
  288.     (define-key global-map 'copy    'x-copy-primary-selection)
  289.     (define-key global-map 'paste    'x-yank-clipboard-selection)
  290.     (define-key global-map 'cut        'x-kill-primary-selection)
  291.  
  292.     (define-key global-map 'menu    'popup-mode-menu)
  293.     ;;(define-key global-map '(shift menu) 'x-goto-menubar) ;NYI
  294.  
  295.     (setq post-x-win-initted t)))
  296.  
  297. ;;; Keyboard initialization needs to be done differently for each X
  298. ;;; console, so use create-console-hook.
  299. (when (featurep 'x)
  300.   (add-hook
  301.    'create-console-hook
  302.    (lambda (console)
  303.      (letf (((selected-console) console))
  304.        (when (eq 'x (console-type console))
  305.      (x-initialize-keyboard)
  306.      (x-initialize-compose))))))
  307.  
  308. (defun make-frame-on-display (display &optional props)
  309.   "Create a frame on the X display named DISPLAY.
  310. DISPLAY should be a standard display string such as \"unix:0\",
  311. or nil for the display specified on the command line or in the
  312. DISPLAY environment variable.
  313.  
  314. PROPS should be a plist of properties, as in the call to `make-frame'.
  315.  
  316. This function opens a connection to the display or reuses an existing
  317. connection.
  318.  
  319. This function is a trivial wrapper around `make-frame-on-device'."
  320.   (interactive "sMake frame on display: ")
  321.   (if (equal display "") (setq display nil))
  322.   (make-frame-on-device 'x display props))
  323.  
  324. ;;; x-init.el ends here
  325.